home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual dBase v5.5 / SAMPLES1.PAK / CHANGDIR.PRG < prev    next >
Encoding:
Text File  |  1995-07-18  |  10.9 KB  |  344 lines
  1. *******************************************************************************
  2. *  PROGRAM:      Changdir.prg
  3. *
  4. *  WRITTEN BY:   Borland Samples Group
  5. *
  6. *  DATE:         11/93
  7. *
  8. *  UPDATED:      6/95
  9. *
  10. *  VERSION:      Visual dBASE
  11. *
  12. *  DESCRIPTION:  This is a tool for changing directories.  It brings up a
  13. *                listbox of the current subdirectories, and lets you traverse
  14. *                your directory tree.  Double clicking in the listbox will
  15. *                select that directory.  Selecting the OK button makes your
  16. *                selected directory the current directory, and the CANCEL
  17. *                button cancels the program.
  18. *
  19. *  PARAMETERS:   None
  20. *
  21. *  CALLS:        Buttons.cc  (Custom Controls file)
  22. *
  23. *  USAGE:        Do Changdir/Changdir()
  24. *
  25. *  NOTE:         Visual dBASE has a function, GetDirectory(), which accomplishes
  26. *                the same task as this program.
  27. *
  28. *******************************************************************************
  29.  
  30. #include <Messdlg.h>
  31. #include <Utils.h>
  32. #define DIRECTORY_ATTRIBUTE   "....D"
  33.  
  34. *** Environment  (alternative to CREATE SESSION)
  35. private saveTalk, saveLdCheck, savePath, saveExact
  36.  
  37. if set("talk" ) = "ON"
  38.    set talk off
  39.    saveTalk = "ON"
  40. else
  41.    saveTalk = "OFF"
  42. endif
  43. saveLdCheck = set("ldCheck")
  44. savePath = setto("path")           && Save current path because it will change
  45. saveExact = set("exact")
  46.  
  47. set ldCheck off
  48. set path to &_dbwinhome.samples
  49. set exact on
  50.  
  51.  
  52. set procedure to program(1) additive
  53. set procedure to &_dbwinhome.samples\Buttons.cc additive
  54.  
  55. local f
  56. f = new ChangDir()
  57. f.ReadModal()
  58.  
  59. *******************************************************************************
  60. *******************************************************************************
  61. class ChangDir of Form
  62. *******************************************************************************
  63.  
  64.    this.top = 5.30
  65.    this.left = 6.76
  66.    this.height = 15.00
  67.    this.width = 54.06
  68.    this.mdi = .F.
  69.    this.sysmenu = .T.
  70.    this.text = "Change Directory"
  71.    this.sizeable = .T.
  72.    this.OnOpen = CLASS::Form_OnOpen
  73.    this.OnClose = CLASS::Form_OnClose
  74.    this.OnSelection = CLASS::OkOnClick
  75.  
  76.    define listbox directList of this;
  77.       property;
  78.          OnLeftDblClick CLASS::SetNewDir,;
  79.          top 3.18,;
  80.          left 1.35,;
  81.          height 11.5,;
  82.          width 36.49,;
  83.          colornormal "b/w",;
  84.          statusmessage "Click on a directory to display it, double click to select it.";
  85.       custom;
  86.          dir set("directory")
  87.  
  88.    define entryfield curDirEntry of this;
  89.       property;
  90.          top 1.06,;
  91.          left 0.00,;
  92.          width 54.06,;
  93.          value space(78),;
  94.          colornormal "b/bg",;
  95.          colorhighlight "b/w",;
  96.          picture "@S78!",;
  97.          statusmessage "Currently selected directory.",;
  98.          OnGotFocus CLASS::CurDirEntry_OnGotFocus,;
  99.          OnLostFocus CLASS::CheckDirExists
  100.  
  101.    define OkButton okToChange of this;
  102.       property;
  103.          OnClick CLASS::OkOnClick,;
  104.          top 3.18,;
  105.          left 39.19,;
  106.          statusmessage "Change directory to the one selected."
  107.  
  108.    define CancelButton cancelChange of this;
  109.       property;
  110.          OnClick CLASS::CancelOnClick,;
  111.          top 5.05,;
  112.          left 39.19,;
  113.          statusmessage "Forget it."
  114.  
  115.    define SampleInfoButton ChangdirInfoButton of this;
  116.       property;
  117.          top 13.5,;
  118.          left 50;
  119.       custom;
  120.          sampleName "Changdir.prg"
  121.  
  122.  
  123.    ******************************************************************************
  124.    procedure Form_OnOpen
  125.    ******************************************************************************
  126.  
  127.    form.saveDir  = set("directory") && save current dir in case Cancel selected
  128.  
  129.    form.curDir = setto("directory") && current directory
  130.    form.CreateDirArray()            && Create array of current subdirectories
  131.  
  132.    form.directList.dataSource = "array form.dirAr"
  133.    form.curDirEntry.dataLink = "form.curDir"
  134.    show object form.directList
  135.    show object form.curDirEntry
  136.  
  137.  
  138.    ******************************************************************************
  139.    procedure Form_OnClose
  140.  
  141.    * Clean up.
  142.    ******************************************************************************
  143.  
  144.    set path to &savePath
  145.    set exact &saveExact
  146.    set ldCheck &saveLdCheck
  147.    close procedure &_dbwinhome.samples\Buttons.cc,;
  148.       program(1)
  149.  
  150.    cd
  151.    set talk &saveTalk              && Private variable
  152.  
  153.  
  154.  
  155.  
  156.    ******************************************************************************
  157.    procedure OkOnClick
  158.  
  159.    * If selected directory exists, change to it, and leave, otherwise,
  160.    * just leave.
  161.    ******************************************************************************
  162.    private curDir       && Macrosubstituted variables cannot be local.
  163.  
  164.    form.curDirEntry.OnLostFocus = .F.   && This would call CheckDirExists again,
  165.    if CLASS::CheckDirExists()           && so turn it off until entryfield gets
  166.       curDir = form.curDir              && focus.
  167.       cd &curDir
  168.       form.Close()
  169.    endif
  170.  
  171.  
  172.    ******************************************************************************
  173.    procedure CancelOnClick
  174.  
  175.    * Restore original directory, and close form.
  176.    ******************************************************************************
  177.    private saveDir      && Macrosubstituted variables cannot be local.
  178.  
  179.    saveDir = form.saveDir
  180.    cd &saveDir
  181.    form.Close()
  182.  
  183.  
  184.    ******************************************************************************
  185.    procedure CurDirEntry_OnGotFocus
  186.  
  187.    * Make sure correct sequence of events gets executed.
  188.    ******************************************************************************
  189.  
  190.    form.prevDir = this.value            && Save current dir just in case
  191.                                         && Assign OnLostFocus now, so no
  192.    this.OnLostFocus = CLASS::CheckDirExists     && confusion between OnSelection
  193.                                                 && and OnLostFocus routines
  194.  
  195.  
  196.    ******************************************************************************
  197.    procedure SetNewDir
  198.  
  199.    * Change to selected directory.
  200.    ******************************************************************************
  201.    private newDir, divideChar, showDir, lastSlashLoc, trimCurDir, curDir
  202.  
  203.    newDir = ALLTRIM(form.directList.value)
  204.    trimCurDir = ALLTRIM(form.curDir)
  205.    lastSlashLoc = rat("\",trimCurDir)
  206.    if .not. empty(newDir) .and. newDir <> "."
  207.       divideChar = iif(right(trimCurDir,1) = "\","","\")
  208.                                     && if last char of
  209.                                     && form.curDir is '\', don't need
  210.                                     && to add it
  211.       if newDir = ".."              && Go back a directory
  212.          && ?more than one branch off the root
  213.          form.curDir = substr(trimCurDir,1,lastSlashLoc - ;
  214.             iif(lastSlashLoc > 3,1,0))
  215.       else
  216.          form.curDir = trimCurDir + iif(.not. empty(newDir),divideChar,"");
  217.             + newDir
  218.       endif
  219.       curDir = form.curDir
  220.       cd &curDir
  221.       form.dirAr = new Array(0)
  222.       form.CreateDirArray()
  223.       show object form.curDirEntry
  224.       show object form.directList
  225.       redefine listbox directList of form;
  226.          property;
  227.            top 3.18,;
  228.            left 1.35,;
  229.            height 11.5,;
  230.            width 36.49,;
  231.            dataSource "array form.dirAr",;
  232.            colornormal "b/w";
  233.          custom;
  234.            dir form.curDir
  235.    endif
  236.  
  237.    ******************************************************************************
  238.    procedure CreateDirArray
  239.  
  240.    * Create array for holding subdirs of current directory.
  241.    ******************************************************************************
  242.    private i, j, tempAr, tempArSize
  243.  
  244.    tempAr = new Array(0)
  245.    tempArSize = tempAr.Dir("*.*",DIRECTORY_ATTRIBUTE)
  246.    j = 0
  247.    form.dirAr = new Array(0)
  248.    for i = 1 to tempArSize
  249.       if tempAr[i,5] = DIRECTORY_ATTRIBUTE   && if directory, add it to form.dirAr
  250.          j = j + 1
  251.          form.dirAr.Grow(1)
  252.          form.dirAr[j] = tempAr[i,1]
  253.       endif
  254.    next i
  255.    form.dirAr.Sort()
  256.  
  257.  
  258.    ******************************************************************************
  259.    function CheckDirExists
  260.  
  261.    * If selected directory exists, change to it.
  262.    ******************************************************************************
  263.    local ratSlash, lenCurDir, exit
  264.    private dirExists, curDir
  265.  
  266.    ratSlash = rat("\", form.curDir)
  267.    lenCurDir = len(rtrim(form.curDir))
  268.    dirExists = .T.
  269.    exit = .F.
  270.  
  271.    do case
  272.       case .not. CLASS::DirExists(form.curDir)
  273.          if ConfirmationMessage(ALLTRIM(form.curDir) + chr(13) +;
  274.             "Doesn't exist. Continue?","Confirmation") = YES
  275.             form.curDir = form.prevDir
  276.             show object form.curDirEntry
  277.          else
  278.             exit = .T.
  279.          endif
  280.          dirExists = .F.
  281.       case form.curDir <> form.directList.dir
  282.          * can't use RIGHT() because  string doesn't necessarily fill value
  283.          if ratSlash = lenCurDir .and. lenCurDir > 3  && get rid of last \
  284.             form.curDir = stuff(form.curDir, ratSlash, 1, "")
  285.          endif
  286.          curDir = form.curDir
  287.          cd &curDir
  288.          show object form.curDirEntry        && Update entryfield display
  289.          form.CreateDirArray()
  290.          redefine listbox directList of form;
  291.             property;
  292.             top 3.18,;
  293.             left 1.35,;
  294.             height 11.5,;
  295.             width 36.49,;
  296.             dataSource "array form.dirAr",;
  297.             colornormal "b/w";
  298.          custom;
  299.             dir form.curDir
  300.          show object form.directList
  301.    endcase
  302.  
  303.    if exit
  304.       form.cancelChange.OnClick()
  305.    endif
  306.  
  307.    return dirExists
  308.  
  309.  
  310.  
  311.    ******************************************************************************
  312.    function DirExists(dir)
  313.  
  314.    * Check if dir exists.
  315.    * Use adir() to create an array of subdirectories of the dir in question.
  316.    * If any subdirectories exist (including ..\.), then dir exists.
  317.    ******************************************************************************
  318.    private d, retVal, lastSlashLoc, returnValue
  319.  
  320.    d = rtrim(dir)
  321.    do case
  322.       case at("\\", d) > 0                         && Double slash
  323.          returnValue = .F.
  324.       case at("::", d) > 0                         && Double colon
  325.          returnValue = .F.
  326.       otherwise
  327.          declare checkAr[1]
  328.          lastChar = right(d, 1)
  329.          if .not. right(d, 1) $ ":\"               && If not drive and has no last\
  330.             d =  d + "\"                           && make dir end with \
  331.          endif
  332.          if file(d + "nul")
  333.             returnValue = .T.                      && Dir exists
  334.          else
  335.             returnValue = .F.                      && Dir doesn't exist
  336.          endif
  337.    endcase
  338.  
  339.    return returnValue
  340.  
  341.  
  342. endclass
  343.  
  344.